Code
pacman::p_load(ggiraph, plotly,
patchwork, DT, tidyverse) Rows: 322 Columns: 7
── Column specification ────────────────────────────────────────────────────────
Delimiter: ","
chr (4): ID, CLASS, GENDER, RACE
dbl (3): ENGLISH, MATHS, SCIENCE
ℹ Use `spec()` to retrieve the full column specification for this data.
ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
exam_data$tooltip <- c(paste0(
"Name = ", exam_data$ID,
"\n Class = ", exam_data$CLASS))
p <- ggplot(data=exam_data,
aes(x = MATHS)) +
geom_dotplot_interactive(
aes(tooltip = exam_data$tooltip),
stackgroups = TRUE,
binwidth = 1,
method = "histodot") +
scale_y_continuous(NULL,
breaks = NULL)
girafe(
ggobj = p,
width_svg = 8,
height_svg = 8*0.618
)tooltip_css <- "background-color:white; #<<
font-style:bold; color:black;" #<<
p <- ggplot(data=exam_data,
aes(x = MATHS)) +
geom_dotplot_interactive(
aes(tooltip = ID),
stackgroups = TRUE,
binwidth = 1,
method = "histodot") +
scale_y_continuous(NULL,
breaks = NULL)
girafe(
ggobj = p,
width_svg = 6,
height_svg = 6*0.618,
options = list( #<<
opts_tooltip( #<<
css = tooltip_css)) #<<
) tooltip <- function(y, ymax, accuracy = .01) {
mean <- scales::number(y, accuracy = accuracy)
sem <- scales::number(ymax - y, accuracy = accuracy)
paste("Mean maths scores:", mean, "+/-", sem)
}
gg_point <- ggplot(data=exam_data,
aes(x = RACE),
) +
stat_summary(aes(y = MATHS,
tooltip = after_stat(
tooltip(y, ymax))),
fun.data = "mean_se",
geom = GeomInteractiveCol,
fill = "light blue"
) +
stat_summary(aes(y = MATHS),
fun.data = mean_se,
geom = "errorbar", width = 0.2, size = 0.2
)Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
ℹ Please use `linewidth` instead.
p <- ggplot(data=exam_data,
aes(x = MATHS)) +
geom_dotplot_interactive(
aes(data_id = CLASS),
stackgroups = TRUE,
binwidth = 1,
method = "histodot") +
scale_y_continuous(NULL,
breaks = NULL)
girafe(
ggobj = p,
width_svg = 6,
height_svg = 6*0.618,
options = list(
opts_hover(css = "fill: #202020;"),
opts_hover_inv(css = "opacity:0.2;")
)
) p <- ggplot(data=exam_data,
aes(x = MATHS)) +
geom_dotplot_interactive(
aes(tooltip = CLASS,
data_id = CLASS),
stackgroups = TRUE,
binwidth = 1,
method = "histodot") +
scale_y_continuous(NULL,
breaks = NULL)
girafe(
ggobj = p,
width_svg = 6,
height_svg = 6*0.618,
options = list(
opts_hover(css = "fill: #202020;"),
opts_hover_inv(css = "opacity:0.2;")
)
) exam_data$onclick <- sprintf("window.open(\"%s%s\")",
"https://www.moe.gov.sg/schoolfinder?journey=Primary%20school",
as.character(exam_data$ID))
p <- ggplot(data=exam_data,
aes(x = MATHS)) +
geom_dotplot_interactive(
aes(onclick = onclick),
stackgroups = TRUE,
binwidth = 1,
method = "histodot") +
scale_y_continuous(NULL,
breaks = NULL)
girafe(
ggobj = p,
width_svg = 6,
height_svg = 6*0.618) p1 <- ggplot(data=exam_data,
aes(x = MATHS)) +
geom_dotplot_interactive(
aes(data_id = ID),
stackgroups = TRUE,
binwidth = 1,
method = "histodot") +
coord_cartesian(xlim=c(0,100)) +
scale_y_continuous(NULL,
breaks = NULL)
p2 <- ggplot(data=exam_data,
aes(x = ENGLISH)) +
geom_dotplot_interactive(
aes(data_id = ID),
stackgroups = TRUE,
binwidth = 1,
method = "histodot") +
coord_cartesian(xlim=c(0,100)) +
scale_y_continuous(NULL,
breaks = NULL)
girafe(code = print(p1 + p2),
width_svg = 6,
height_svg = 3,
options = list(
opts_hover(css = "fill: #202020;"),
opts_hover_inv(css = "opacity:0.2;")
)
) No trace type specified:
Based on info supplied, a 'scatter' trace seems appropriate.
Read more about this trace type -> https://plotly.com/r/reference/#scatter
No scatter mode specifed:
Setting the mode to markers
Read more about this attribute -> https://plotly.com/r/reference/#scatter-mode
No trace type specified:
Based on info supplied, a 'scatter' trace seems appropriate.
Read more about this trace type -> https://plotly.com/r/reference/#scatter
No scatter mode specifed:
Setting the mode to markers
Read more about this attribute -> https://plotly.com/r/reference/#scatter-mode
d <- highlight_key(exam_data)
p1 <- ggplot(data=d,
aes(x = MATHS,
y = ENGLISH)) +
geom_point(size=1) +
coord_cartesian(xlim=c(0,100),
ylim=c(0,100))
p2 <- ggplot(data=d,
aes(x = MATHS,
y = SCIENCE)) +
geom_point(size=1) +
coord_cartesian(xlim=c(0,100),
ylim=c(0,100))
subplot(ggplotly(p1),
ggplotly(p2))Setting the `off` event (i.e., 'plotly_deselect') to match the `on` event (i.e., 'plotly_selected'). You can change this default via the `highlight()` function.
Setting the `off` event (i.e., 'plotly_deselect') to match the `on` event (i.e., 'plotly_selected'). You can change this default via the `highlight()` function.
Rows: 100928 Columns: 7
── Column specification ────────────────────────────────────────────────────────
Delimiter: ","
chr (5): PA, SZ, AG, Sex, TOD
dbl (2): Pop, Time
ℹ Use `spec()` to retrieve the full column specification for this data.
ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
# 2. Data Transformation (Wrangling)
# We need to pivot the data from "Long" (Age Groups in rows) to "Wide" (Young/Old columns)
pop_data <- raw_data %>%
# Create a simplified Age Category flag
mutate(Age_Category = case_when(
AG %in% c("0_to_4", "5_to_9", "10_to_14") ~ "Young",
AG %in% c("65_to_69", "70_to_74", "75_to_79", "80_to_84", "85_to_89", "90_and_over") ~ "Old",
TRUE ~ "Working_Age"
)) %>%
# Group by Planning Area (PA) and Time to aggregate
group_by(PA, Time) %>%
summarise(
Total_Pop = sum(Pop),
Young_Pop = sum(Pop[Age_Category == "Young"]),
Old_Pop = sum(Pop[Age_Category == "Old"]),
.groups = 'drop'
) %>%
# Filter out areas with 0 population to avoid errors
filter(Total_Pop > 0) %>%
# Calculate Percentages
mutate(Percent_Young = (Young_Pop / Total_Pop) * 100,
Percent_Old = (Old_Pop / Total_Pop) * 100)
# Inspect the result
head(pop_data)# A tibble: 6 × 7
PA Time Total_Pop Young_Pop Old_Pop Percent_Young Percent_Old
<chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 Ang Mo Kio 2025 159380 16380 41960 10.3 26.3
2 Bedok 2025 274650 31820 65060 11.6 23.7
3 Bishan 2025 87610 10850 19930 12.4 22.7
4 Bukit Batok 2025 166150 22890 30520 13.8 18.4
5 Bukit Merah 2025 146790 16190 36920 11.0 25.2
6 Bukit Panjang 2025 136720 18070 24690 13.2 18.1
# Create interactive plot using ggplotly
# Note: We include 'frame = Time' and 'ids = PA' for the animation logic
gg <- ggplot(pop_data, aes(x = Percent_Old, y = Percent_Young,
size = Total_Pop,
colour = PA)) +
geom_point(aes(size = Total_Pop,
),
alpha = 0.7) +
scale_size(range = c(2, 12)) +
labs(x = '% Aged',
y = '% Young') +
theme(legend.position='none')
ggplotly(gg)ggplot(pop_data, aes(x = Percent_Old, y = Percent_Young,
size = Total_Pop,
colour = PA)) +
geom_point(alpha = 0.7,
show.legend = FALSE) +
# scale_colour_manual(values = country_colors) + <-- Removed: Incompatible with PA data
scale_size(range = c(2, 12)) +
labs(title = 'Year: {frame_time}',
x = '% Aged',
y = '% Young')
Rows: 100928 Columns: 7
── Column specification ────────────────────────────────────────────────────────
Delimiter: ","
chr (5): PA, SZ, AG, Sex, TOD
dbl (2): Pop, Time
ℹ Use `spec()` to retrieve the full column specification for this data.
ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
# 2. Transform to calculate % Young and % Old per Planning Area
pop_data <- raw_data %>%
mutate(Age_Category = case_when(
AG %in% c("0_to_4", "5_to_9", "10_to_14") ~ "Young",
AG %in% c("65_to_69", "70_to_74", "75_to_79", "80_to_84", "85_to_89", "90_and_over") ~ "Old",
TRUE ~ "Working_Age"
)) %>%
group_by(PA, Time) %>%
summarise(
Total_Pop = sum(Pop),
Young_Pop = sum(Pop[Age_Category == "Young"]),
Old_Pop = sum(Pop[Age_Category == "Old"]),
.groups = 'drop'
) %>%
filter(Total_Pop > 0) %>%
mutate(Percent_Young = (Young_Pop / Total_Pop) * 100,
Percent_Old = (Old_Pop / Total_Pop) * 100)Warning in RColorBrewer::brewer.pal(max(N, 3L), "Set2"): n too large, allowed maximum for palette Set2 is 8
Returning the palette you asked for with that many colors
Warning in RColorBrewer::brewer.pal(max(N, 3L), "Set2"): n too large, allowed maximum for palette Set2 is 8
Returning the palette you asked for with that many colors


Rows: 100928 Columns: 7
── Column specification ────────────────────────────────────────────────────────
Delimiter: ","
chr (5): PA, SZ, AG, Sex, TOD
dbl (2): Pop, Time
ℹ Use `spec()` to retrieve the full column specification for this data.
ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
pop_data <- raw_data %>%
mutate(Age_Category = case_when(
AG %in% c("0_to_4", "5_to_9", "10_to_14") ~ "Young",
AG %in% c("65_to_69", "70_to_74", "75_to_79", "80_to_84", "85_to_89", "90_and_over") ~ "Old",
TRUE ~ "Working_Age"
)) %>%
group_by(PA, Time) %>%
summarise(
Total_Pop = sum(Pop),
Young_Pop = sum(Pop[Age_Category == "Young"]),
Old_Pop = sum(Pop[Age_Category == "Old"]),
.groups = 'drop'
) %>%
filter(Total_Pop > 0) %>%
mutate(Percent_Young = (Young_Pop / Total_Pop) * 100,
Percent_Old = (Old_Pop / Total_Pop) * 100)
# 3. (Optional) Simulate Data for 2020
# We create a fake 2020 dataset so the Play button actually moves dots!
pop_data_simulated <- pop_data %>%
mutate(Time = 2025) %>%
bind_rows(
pop_data %>%
mutate(Time = 2020,
Percent_Old = Percent_Old * 0.85, # Pretend 2020 was younger
Percent_Young = Percent_Young * 1.1) # Pretend 2020 had more kids
)
# 4. Build the Animated Plot using ggplotly method
# Note: usage of frame = Time creates the slider
# Note: usage of theme(legend.position='none') removes the legend
gg <- ggplot(pop_data_simulated,
aes(x = Percent_Old,
y = Percent_Young,
size = Total_Pop,
colour = PA)) +
geom_point(aes(size = Total_Pop,
), # Ensures smooth transition of specific bubbles
alpha = 0.7) +
scale_size(range = c(2, 12)) +
labs(x = '% Aged',
y = '% Young') +
theme(legend.position='none') # Removes the legend as requested
# 5. Generate the Interactive Plot
ggplotly(gg)Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
# 1. Load Packages
pacman::p_load(tidyverse, plotly)
# 2. Build the Plot (Clean Version)
bp <- globalPop %>%
plot_ly(x = ~Old,
y = ~Young,
size = ~Population,
color = ~Continent,
sizes = c(2, 100),
frame = ~Year,
text = ~Country,
hoverinfo = "text",
type = 'scatter',
mode = 'markers',
# FIX: Explicitly define marker line width to 0 to stop the warning
marker = list(sizemode = 'diameter',
opacity = 0.7,
line = list(width = 0))
) %>%
layout(showlegend = FALSE,
xaxis = list(title = '% Aged'),
yaxis = list(title = '% Young'),
title = "Global Population Dynamics")
# 3. Display the plot
bpWarning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
Warning: `line.width` does not currently support multiple values.
---
title: "Hands-on Exercise 3"
format:
html:
toc: true
toc-title: "Table of Contents"
toc-location: left
code-fold: show
code-tools: true
theme: cosmo
editor: visual
---
#### ***this is the third exercise***
# **First Part**
```{r}
pacman::p_load(ggiraph, plotly,
patchwork, DT, tidyverse)
```
```{r}
exam_data <- read_csv("Exam_data.csv")
```
```{r}
p <- ggplot(data=exam_data,
aes(x = MATHS)) +
geom_dotplot_interactive(
aes(tooltip = ID),
stackgroups = TRUE,
binwidth = 1,
method = "histodot") +
scale_y_continuous(NULL,
breaks = NULL)
girafe(
ggobj = p,
width_svg = 6,
height_svg = 6*0.618
)
```
```{r}
exam_data$tooltip <- c(paste0(
"Name = ", exam_data$ID,
"\n Class = ", exam_data$CLASS))
p <- ggplot(data=exam_data,
aes(x = MATHS)) +
geom_dotplot_interactive(
aes(tooltip = exam_data$tooltip),
stackgroups = TRUE,
binwidth = 1,
method = "histodot") +
scale_y_continuous(NULL,
breaks = NULL)
girafe(
ggobj = p,
width_svg = 8,
height_svg = 8*0.618
)
```
```{r}
tooltip_css <- "background-color:white; #<<
font-style:bold; color:black;" #<<
p <- ggplot(data=exam_data,
aes(x = MATHS)) +
geom_dotplot_interactive(
aes(tooltip = ID),
stackgroups = TRUE,
binwidth = 1,
method = "histodot") +
scale_y_continuous(NULL,
breaks = NULL)
girafe(
ggobj = p,
width_svg = 6,
height_svg = 6*0.618,
options = list( #<<
opts_tooltip( #<<
css = tooltip_css)) #<<
)
```
```{r}
tooltip <- function(y, ymax, accuracy = .01) {
mean <- scales::number(y, accuracy = accuracy)
sem <- scales::number(ymax - y, accuracy = accuracy)
paste("Mean maths scores:", mean, "+/-", sem)
}
gg_point <- ggplot(data=exam_data,
aes(x = RACE),
) +
stat_summary(aes(y = MATHS,
tooltip = after_stat(
tooltip(y, ymax))),
fun.data = "mean_se",
geom = GeomInteractiveCol,
fill = "light blue"
) +
stat_summary(aes(y = MATHS),
fun.data = mean_se,
geom = "errorbar", width = 0.2, size = 0.2
)
girafe(ggobj = gg_point,
width_svg = 8,
height_svg = 8*0.618)
```
```{r}
p <- ggplot(data=exam_data,
aes(x = MATHS)) +
geom_dotplot_interactive(
aes(data_id = CLASS),
stackgroups = TRUE,
binwidth = 1,
method = "histodot") +
scale_y_continuous(NULL,
breaks = NULL)
girafe(
ggobj = p,
width_svg = 6,
height_svg = 6*0.618
)
```
```{r}
p <- ggplot(data=exam_data,
aes(x = MATHS)) +
geom_dotplot_interactive(
aes(data_id = CLASS),
stackgroups = TRUE,
binwidth = 1,
method = "histodot") +
scale_y_continuous(NULL,
breaks = NULL)
girafe(
ggobj = p,
width_svg = 6,
height_svg = 6*0.618,
options = list(
opts_hover(css = "fill: #202020;"),
opts_hover_inv(css = "opacity:0.2;")
)
)
```
```{r}
p <- ggplot(data=exam_data,
aes(x = MATHS)) +
geom_dotplot_interactive(
aes(tooltip = CLASS,
data_id = CLASS),
stackgroups = TRUE,
binwidth = 1,
method = "histodot") +
scale_y_continuous(NULL,
breaks = NULL)
girafe(
ggobj = p,
width_svg = 6,
height_svg = 6*0.618,
options = list(
opts_hover(css = "fill: #202020;"),
opts_hover_inv(css = "opacity:0.2;")
)
)
```
```{r}
exam_data$onclick <- sprintf("window.open(\"%s%s\")",
"https://www.moe.gov.sg/schoolfinder?journey=Primary%20school",
as.character(exam_data$ID))
p <- ggplot(data=exam_data,
aes(x = MATHS)) +
geom_dotplot_interactive(
aes(onclick = onclick),
stackgroups = TRUE,
binwidth = 1,
method = "histodot") +
scale_y_continuous(NULL,
breaks = NULL)
girafe(
ggobj = p,
width_svg = 6,
height_svg = 6*0.618)
```
```{r}
p1 <- ggplot(data=exam_data,
aes(x = MATHS)) +
geom_dotplot_interactive(
aes(data_id = ID),
stackgroups = TRUE,
binwidth = 1,
method = "histodot") +
coord_cartesian(xlim=c(0,100)) +
scale_y_continuous(NULL,
breaks = NULL)
p2 <- ggplot(data=exam_data,
aes(x = ENGLISH)) +
geom_dotplot_interactive(
aes(data_id = ID),
stackgroups = TRUE,
binwidth = 1,
method = "histodot") +
coord_cartesian(xlim=c(0,100)) +
scale_y_continuous(NULL,
breaks = NULL)
girafe(code = print(p1 + p2),
width_svg = 6,
height_svg = 3,
options = list(
opts_hover(css = "fill: #202020;"),
opts_hover_inv(css = "opacity:0.2;")
)
)
```
```{r}
plot_ly(data = exam_data,
x = ~MATHS,
y = ~ENGLISH)
plot_ly(data = exam_data,
x = ~ENGLISH,
y = ~MATHS,
color = ~RACE)
p <- ggplot(data=exam_data,
aes(x = MATHS,
y = ENGLISH)) +
geom_point(size=1) +
coord_cartesian(xlim=c(0,100),
ylim=c(0,100))
ggplotly(p)
d <- highlight_key(exam_data)
p1 <- ggplot(data=d,
aes(x = MATHS,
y = ENGLISH)) +
geom_point(size=1) +
coord_cartesian(xlim=c(0,100),
ylim=c(0,100))
p2 <- ggplot(data=d,
aes(x = MATHS,
y = SCIENCE)) +
geom_point(size=1) +
coord_cartesian(xlim=c(0,100),
ylim=c(0,100))
subplot(ggplotly(p1),
ggplotly(p2))
```
```{r}
DT::datatable(exam_data, class= "compact")
d <- highlight_key(exam_data)
p <- ggplot(d,
aes(ENGLISH,
MATHS)) +
geom_point(size=1) +
coord_cartesian(xlim=c(0,100),
ylim=c(0,100))
gg <- highlight(ggplotly(p),
"plotly_selected")
crosstalk::bscols(gg,
DT::datatable(d),
widths = 5)
```
```{r}
d <- highlight_key(exam_data)
p <- ggplot(d,
aes(ENGLISH,
MATHS)) +
geom_point(size=1) +
coord_cartesian(xlim=c(0,100),
ylim=c(0,100))
gg <- highlight(ggplotly(p),
"plotly_selected")
crosstalk::bscols(gg,
DT::datatable(d),
widths = 5)
```
# **Second Part**
```{r}
pacman::p_load(readxl, gifski, gapminder,
plotly, gganimate, tidyverse)
```
```{r}
pacman::p_load(tidyverse, gganimate, plotly, gifski)
# 1. Import Data
raw_data <- read_csv("respopagesextod2025.csv")
# 2. Data Transformation (Wrangling)
# We need to pivot the data from "Long" (Age Groups in rows) to "Wide" (Young/Old columns)
pop_data <- raw_data %>%
# Create a simplified Age Category flag
mutate(Age_Category = case_when(
AG %in% c("0_to_4", "5_to_9", "10_to_14") ~ "Young",
AG %in% c("65_to_69", "70_to_74", "75_to_79", "80_to_84", "85_to_89", "90_and_over") ~ "Old",
TRUE ~ "Working_Age"
)) %>%
# Group by Planning Area (PA) and Time to aggregate
group_by(PA, Time) %>%
summarise(
Total_Pop = sum(Pop),
Young_Pop = sum(Pop[Age_Category == "Young"]),
Old_Pop = sum(Pop[Age_Category == "Old"]),
.groups = 'drop'
) %>%
# Filter out areas with 0 population to avoid errors
filter(Total_Pop > 0) %>%
# Calculate Percentages
mutate(Percent_Young = (Young_Pop / Total_Pop) * 100,
Percent_Old = (Old_Pop / Total_Pop) * 100)
# Inspect the result
head(pop_data)
```
```{r}
# Create the base static plot
p <- ggplot(pop_data, aes(x = Percent_Old, y = Percent_Young,
size = Total_Pop,
colour = PA)) +
geom_point(alpha = 0.7,
show.legend = FALSE) +
scale_size(range = c(2, 12)) +
labs(title = 'Year: {frame_time}',
x = '% Aged (65+)',
y = '% Young (0-14)') +
theme_minimal()
```
```{r}
# Create interactive plot using ggplotly
# Note: We include 'frame = Time' and 'ids = PA' for the animation logic
gg <- ggplot(pop_data, aes(x = Percent_Old, y = Percent_Young,
size = Total_Pop,
colour = PA)) +
geom_point(aes(size = Total_Pop,
),
alpha = 0.7) +
scale_size(range = c(2, 12)) +
labs(x = '% Aged',
y = '% Young') +
theme(legend.position='none')
ggplotly(gg)
```
```{r}
ggplot(pop_data, aes(x = Percent_Old, y = Percent_Young,
size = Total_Pop,
colour = PA)) +
geom_point(alpha = 0.7,
show.legend = FALSE) +
# scale_colour_manual(values = country_colors) + <-- Removed: Incompatible with PA data
scale_size(range = c(2, 12)) +
labs(title = 'Year: {frame_time}',
x = '% Aged',
y = '% Young')
```
```{r}
# Load necessary libraries
pacman::p_load(tidyverse, gganimate)
# 1. Import
raw_data <- read_csv("respopagesextod2025.csv")
# 2. Transform to calculate % Young and % Old per Planning Area
pop_data <- raw_data %>%
mutate(Age_Category = case_when(
AG %in% c("0_to_4", "5_to_9", "10_to_14") ~ "Young",
AG %in% c("65_to_69", "70_to_74", "75_to_79", "80_to_84", "85_to_89", "90_and_over") ~ "Old",
TRUE ~ "Working_Age"
)) %>%
group_by(PA, Time) %>%
summarise(
Total_Pop = sum(Pop),
Young_Pop = sum(Pop[Age_Category == "Young"]),
Old_Pop = sum(Pop[Age_Category == "Old"]),
.groups = 'drop'
) %>%
filter(Total_Pop > 0) %>%
mutate(Percent_Young = (Young_Pop / Total_Pop) * 100,
Percent_Old = (Old_Pop / Total_Pop) * 100)
```
```{r}
gg <- ggplot(pop_data,
aes(x = Percent_Old,
y = Percent_Young,
size = Total_Pop,
colour = PA)) +
geom_point(aes(size = Total_Pop,
),
alpha = 0.7,
show.legend = FALSE) +
scale_size(range = c(2, 12)) +
labs(x = '% Aged',
y = '% Young')
ggplotly(gg)
```
```{r}
gg <- ggplot(pop_data,
aes(x = Percent_Old,
y = Percent_Young,
size = Total_Pop,
colour = PA)) +
geom_point(aes(size = Total_Pop,
),
alpha = 0.7) +
scale_size(range = c(2, 12)) +
labs(x = '% Aged',
y = '% Young') +
theme(legend.position='none')
ggplotly(gg)
```
```{r}
bp <- pop_data %>%
plot_ly(x = ~Percent_Old,
y = ~Percent_Young,
size = ~Total_Pop,
color = ~PA,
sizes = c(2, 100),
frame = ~Time,
text = ~PA,
hoverinfo = "text",
type = 'scatter',
mode = 'markers'
) %>%
layout(showlegend = FALSE)
bp
```
```{r}
ggplot(pop_data, aes(x = Percent_Old, y = Percent_Young,
size = Total_Pop,
colour = PA)) +
geom_point(alpha = 0.7,
show.legend = FALSE) +
scale_size(range = c(2, 12)) +
labs(title = 'Year: 2025', # Hardcoded since it's only 2025
x = '% Aged',
y = '% Young')
```
```{r}
pacman::p_load(readxl, gifski, gapminder,
plotly, gganimate, tidyverse)
```
```{r}
col <- c("Country", "Continent")
globalPop <- read_xls("GlobalPopulation.xls",
sheet="Data") %>%
mutate_at(col, as.factor) %>%
mutate(Year = as.integer(Year))
```
```{r}
ggplot(globalPop, aes(x = Old, y = Young,
size = Population,
colour = Country)) +
geom_point(alpha = 0.7,
show.legend = FALSE) +
scale_colour_manual(values = country_colors) +
scale_size(range = c(2, 12)) +
labs(title = 'Year: {frame_time}',
x = '% Aged',
y = '% Young')
```
```{r}
gg <- ggplot(globalPop,
aes(x = Old,
y = Young,
size = Population,
colour = Country)) +
geom_point(aes(size = Population,
),
alpha = 0.7,
show.legend = FALSE) +
scale_colour_manual(values = country_colors) +
scale_size(range = c(2, 12)) +
labs(x = '% Aged',
y = '% Young')
ggplotly(gg)
```
```{r}
# 1. Load Packages
pacman::p_load(tidyverse, plotly, gganimate)
# 2. Import and Transform Data
# We first calculate the % Young and % Old for each area
raw_data <- read_csv("respopagesextod2025.csv")
pop_data <- raw_data %>%
mutate(Age_Category = case_when(
AG %in% c("0_to_4", "5_to_9", "10_to_14") ~ "Young",
AG %in% c("65_to_69", "70_to_74", "75_to_79", "80_to_84", "85_to_89", "90_and_over") ~ "Old",
TRUE ~ "Working_Age"
)) %>%
group_by(PA, Time) %>%
summarise(
Total_Pop = sum(Pop),
Young_Pop = sum(Pop[Age_Category == "Young"]),
Old_Pop = sum(Pop[Age_Category == "Old"]),
.groups = 'drop'
) %>%
filter(Total_Pop > 0) %>%
mutate(Percent_Young = (Young_Pop / Total_Pop) * 100,
Percent_Old = (Old_Pop / Total_Pop) * 100)
# 3. (Optional) Simulate Data for 2020
# We create a fake 2020 dataset so the Play button actually moves dots!
pop_data_simulated <- pop_data %>%
mutate(Time = 2025) %>%
bind_rows(
pop_data %>%
mutate(Time = 2020,
Percent_Old = Percent_Old * 0.85, # Pretend 2020 was younger
Percent_Young = Percent_Young * 1.1) # Pretend 2020 had more kids
)
# 4. Build the Animated Plot using ggplotly method
# Note: usage of frame = Time creates the slider
# Note: usage of theme(legend.position='none') removes the legend
gg <- ggplot(pop_data_simulated,
aes(x = Percent_Old,
y = Percent_Young,
size = Total_Pop,
colour = PA)) +
geom_point(aes(size = Total_Pop,
), # Ensures smooth transition of specific bubbles
alpha = 0.7) +
scale_size(range = c(2, 12)) +
labs(x = '% Aged',
y = '% Young') +
theme(legend.position='none') # Removes the legend as requested
# 5. Generate the Interactive Plot
ggplotly(gg)
```
```{r}
gg <- ggplot(globalPop,
aes(x = Old,
y = Young,
size = Population,
colour = Country)) +
geom_point(aes(size = Population,
),
alpha = 0.7) +
scale_colour_manual(values = country_colors) +
scale_size(range = c(2, 12)) +
labs(x = '% Aged',
y = '% Young') +
theme(legend.position='none')
ggplotly(gg)
```
```{r}
bp <- globalPop %>%
plot_ly(x = ~Old,
y = ~Young,
size = ~Population,
color = ~Continent,
sizes = c(2, 100),
frame = ~Year,
text = ~Country,
hoverinfo = "text",
type = 'scatter',
mode = 'markers'
) %>%
layout(showlegend = FALSE)
bp
```
```{r}
# 1. Load Packages
pacman::p_load(tidyverse, plotly)
# 2. Build the Plot (Clean Version)
bp <- globalPop %>%
plot_ly(x = ~Old,
y = ~Young,
size = ~Population,
color = ~Continent,
sizes = c(2, 100),
frame = ~Year,
text = ~Country,
hoverinfo = "text",
type = 'scatter',
mode = 'markers',
# FIX: Explicitly define marker line width to 0 to stop the warning
marker = list(sizemode = 'diameter',
opacity = 0.7,
line = list(width = 0))
) %>%
layout(showlegend = FALSE,
xaxis = list(title = '% Aged'),
yaxis = list(title = '% Young'),
title = "Global Population Dynamics")
# 3. Display the plot
bp
```